Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/graphi2a/graphics.frm

Text File | 1999-09-20 | 11KB | 469 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Graphics
   BackColor       =   &H00000000&
   Caption         =   "Graphics"
   ClientHeight    =   8355
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   9600
   LinkTopic       =   "Form1"
   ScaleHeight     =   8355
   ScaleWidth      =   9600
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer7
      Interval        =   100
      Left            =   8880
      Top             =   1320
   End
   Begin VB.VScrollBar VSbcirc
      Height          =   1575
      LargeChange     =   2
      Left            =   0
      Max             =   700
      TabIndex        =   2
      Top             =   0
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Timer Timer6
      Interval        =   500
      Left            =   8880
      Top             =   1200
   End
   Begin VB.Timer Timer5
      Interval        =   100
      Left            =   8880
      Top             =   1080
   End
   Begin VB.Timer Timer4
      Interval        =   10
      Left            =   8880
      Top             =   960
   End
   Begin VB.Timer Timer3
      Interval        =   1
      Left            =   8880
      Top             =   840
   End
   Begin VB.Timer Timer2
      Interval        =   1
      Left            =   8880
      Top             =   720
   End
   Begin VB.Timer Timer1
      Interval        =   1
      Left            =   8880
      Top             =   600
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   8880
      Top             =   7440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H80000009&
      Height          =   255
      Left            =   0
      ScaleHeight     =   195
      ScaleWidth      =   195
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label Label1
      BackColor       =   &H80000007&
      Height          =   135
      Left            =   9120
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
   Begin VB.Menu mnuTools
      Caption         =   "&Tools"
      Begin VB.Menu mnuMarker
         Caption         =   "&Marker"
      End
      Begin VB.Menu mnuPencil
         Caption         =   "&Pencil"
      End
      Begin VB.Menu mnuCircle
         Caption         =   "&Circle"
      End
      Begin VB.Menu mnuLine
         Caption         =   "&Line"
      End
   End
   Begin VB.Menu mnuback
      Caption         =   "&Back Ground"
      Begin VB.Menu mnuStyle
         Caption         =   "Fill &Style"
      End
      Begin VB.Menu MnuFill
         Caption         =   "&Fill"
      End
   End
   Begin VB.Menu MnuEffects
      Caption         =   "&Effects"
      Begin VB.Menu mnuStaticC
         Caption         =   "&Static Color"
      End
      Begin VB.Menu mnuSlide
         Caption         =   "Static S&lide"
      End
      Begin VB.Menu mnustaticBW
         Caption         =   "Static &Black"
      End
      Begin VB.Menu mnuStar
         Caption         =   "St&ar"
      End
      Begin VB.Menu mnuStarBack
         Caption         =   "Star &Variation"
      End
      Begin VB.Menu mnuRnd
         Caption         =   "&RandomLines"
      End
      Begin VB.Menu mnucircm
         Caption         =   "C&ircles (manual)"
      End
      Begin VB.Menu mnuCircles
         Caption         =   "&Circles"
      End
   End
   Begin VB.Menu mnuColor
      Caption         =   "&Color"
      Begin VB.Menu mnuPallete
         Caption         =   "Color&Pallete"
      End
   End
   Begin VB.Menu mnuClear
      Caption         =   "Clear"
   End
   Begin VB.Menu mnuThumb
      Caption         =   "&Thumbnail"
   End
   Begin VB.Menu mnupicbox
      Caption         =   "&Picture Box"
   End
   Begin VB.Menu mnuflash
      Caption         =   "&Font Flasher"
   End
End
Attribute VB_Name = "Graphics"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public colorch
Dim gstatic
Dim gstaticBW
Dim gstaticsl
Dim gstar
Dim gstarb
Dim gline
Dim x
Dim y
Dim r
Dim g
Dim b
Dim line2
Dim pencil
Dim circ
Dim drawcirc
Dim circle1
Dim sizecirc

Private Sub Form_Load()
colorch = RGB(255, 255, 255)
gstatic = 0
circle1 = 0
gstaticBW = 0
gstaticsl = 0
gstar = 0
gstarb = 0
gline = 0
line2 = 0
pencil = 0
circ = 0
drawcirc = 0
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Graphics.CurrentX = x
Graphics.CurrentY = y
If line2 = 1 Then
Line (Graphics.CurrentX, Graphics.CurrentY)-(x, y), colorch
End If
If circle1 = 1 Then
Circle (x, y), sizecirc, colorch
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)


If pencil = 1 Then
Line (Graphics.CurrentX, Graphics.CurrentY)-(x, y), colorch
End If
End Sub

Private Sub mnuCircle_Click()
circle1 = 1
sizecirc = InputBox("What size: 1 to 20", "Circle Size")
sizecirc = sizecirc * 50
End Sub

Private Sub mnuCircles_Click()
circ = 1
End Sub

Private Sub mnucircm_Click()
VSbcirc.Visible = Not VSbcirc.Visible
End Sub

Private Sub mnuClear_Click()
Graphics.Cls
circ = 0
gstatic = 0
gstaticBW = 0
gstaticsl = 0
gstar = 0
gstarb = 0
gline = 0
End Sub

Private Sub MnuFill_Click()
On Error GoTo error
    CommonDialog1.Action = 3
    Graphics.BackColor = CommonDialog1.Color
Exit Sub
error:
    MsgBox "Cancelled by user."
End Sub

Private Sub mnuflash_Click()
Flash.Show
Unload Graphics
End Sub

Private Sub mnuLine_Click()
line2 = 1
End Sub

Public Sub mnuPallete_Click()
On Error GoTo error
    CommonDialog1.Action = 3
    colorch = CommonDialog1.Color
    Label1.BackColor = colorch
Exit Sub
error:
    MsgBox "Cancelled by user."
End Sub

Private Sub mnupicbox_Click()
    Picture1.Width = Graphics.ScaleWidth
    Picture1.Height = Graphics.ScaleHeight
    Picture1.Visible = Not Picture1.Visible
End Sub

Private Sub mnuRnd_Click()
    gline = 1
End Sub

Private Sub mnuSlide_Click()
    gstaticsl = 1
End Sub

Private Sub mnuStar_Click()
    gstar = 1
End Sub

Private Sub mnuStarBack_Click()
    gstarb = 1
End Sub

Private Sub mnustaticBW_Click()
    gstaticBW = 1
End Sub

Private Sub mnuStaticC_Click()
    gstatic = 1
End Sub

Private Sub mnuStyle_Click()
Dim chose2
Dim return2
return2 = Chr(13) + Chr(10)
chose2 = InputBox("What style do you want:" + return2 + _
    "0 = Solid" + return2 + _
    "1 = Transparent" + return2 + "2 = Horizontal Lines" _
    + return2 + "3 = Vertical Lines" + return2 + "4 = Upward Diagonal" _
    + return2 + "5 = Downward Diagonal" + return2 + "6 = Crosshatch" _
    + return2 + "7 = Diagonal Crosshatch", "Choose Fill Style", 1)
If vbOK Then
        x = Graphics.ScaleWidth
        y = Graphics.ScaleHeight
    Graphics.FillColor = colorch
    Graphics.FillStyle = Val(chose2)
    'Graphics.Line (100, 80)-Step(x, y), RGB(0, 0, 0), B
   Else
  Exit Sub
 End If
End Sub

Private Sub mnuThumb_Click()
    thumbnail.Show
End Sub
Private Sub Timer1_Timer()
Dim r, g, b
Dim x, y
Dim counter
If gstatic = 1 Then
    For counter = 1 To 100 Step 1
        r = Rnd * 255
        g = Rnd * 255
        b = Rnd * 255
        x = Rnd * Graphics.ScaleWidth
        y = Rnd * Graphics.ScaleHeight
        Graphics.PSet (x, y), RGB(r, g, b)
    Next
End If
End Sub

Private Sub Timer2_Timer()

Dim x, y
Dim counter
If gstaticBW = 1 Then
    For counter = 1 To 1000 Step 1

        x = Rnd * Graphics.ScaleWidth
        y = Rnd * Graphics.ScaleHeight
        Graphics.PSet (x, y), RGB(0, 0, 0)
    Next
End If
En